home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swags_z.zip / STRINGS.SWG / 0065_HEXWRITE Strings.pas < prev    next >
Pascal/Delphi Source File  |  1993-11-21  |  4KB  |  162 lines
  1. {$R-}
  2. UNIT HexWrite;
  3. (**) INTERFACE (**)
  4. TYPE HexString = String[9];
  5.   BinString = String[32];
  6.  
  7.   FUNCTION HexByte(B : Byte) : HexString;
  8.   FUNCTION HexShortInt(S : ShortInt) : HexString;
  9.   FUNCTION HexWord(W : Word) : HexString;
  10.   FUNCTION HexInteger(I : Integer) : HexString;
  11.   FUNCTION HexLongInt(L : LongInt) : HexString;
  12.   FUNCTION HexPointer(VAR P) : HexString;
  13.  
  14.   FUNCTION BinByte(B : Byte) : BinString;
  15.   FUNCTION BinShortInt(S : ShortInt) : BinString;
  16.   FUNCTION BinWord(W : Word) : BinString;
  17.   FUNCTION BinInteger(I : Integer) : BinString;
  18.   FUNCTION BinLongInt(L : LongInt) : BinString;
  19.  
  20.   FUNCTION NumBin(B : BinString) : LongInt;
  21.   FUNCTION ANumBin(B : BinString) : LongInt;
  22. (**) IMPLEMENTATION (**)
  23. CONST
  24.   HexDigits : ARRAY[0..15] OF Char = '0123456789ABCDEF';
  25.   BinNibbles : ARRAY[0..15] OF ARRAY[0..3] OF Char = (
  26.     '0000', '0001', '0010', '0011',
  27.     '0100', '0101', '0110', '0111',
  28.     '1000', '1001', '1010', '1011',
  29.     '1100', '1101', '1110', '1111');
  30.  
  31.   FUNCTION HexByte(B : Byte) : HexString;
  32.   VAR Temp : HexString;
  33.   BEGIN
  34.     Temp[0] := #2;
  35.     Temp[1] := HexDigits[B SHR 4];
  36.     Temp[2] := HexDigits[B AND $F];
  37.     HexByte := Temp;
  38.   END;
  39.  
  40.   FUNCTION HexShortInt(S : ShortInt) : HexString;
  41.   BEGIN HexShortInt := HexByte(Byte(S)); END;
  42.  
  43.   FUNCTION HexWord(W : Word) : HexString;
  44.   VAR Temp : HexString;
  45.   BEGIN
  46.     Temp[0] := #4;
  47.     Temp[1] := HexDigits[W SHR 12];
  48.     Temp[2] := HexDigits[(W SHR 8) AND $F];
  49.     Temp[3] := HexDigits[(W SHR 4) AND $F];
  50.     Temp[4] := HexDigits[W AND $F];
  51.     HexWord := Temp;
  52.   END;
  53.  
  54.   FUNCTION HexInteger(I : Integer) : HexString;
  55.   BEGIN HexInteger := HexWord(Word(I)); END;
  56.  
  57.   FUNCTION HexLongInt(L : LongInt) : HexString;
  58.   VAR Temp : HexString;
  59.   BEGIN
  60.     Temp[0] := #8;
  61.     Temp[1] := HexDigits[L SHR 28];
  62.     Temp[2] := HexDigits[(L SHR 24) AND $F];
  63.     Temp[3] := HexDigits[(L SHR 20) AND $F];
  64.     Temp[4] := HexDigits[(L SHR 16) AND $F];
  65.     Temp[5] := HexDigits[(L SHR 12) AND $F];
  66.     Temp[6] := HexDigits[(L SHR 8) AND $F];
  67.     Temp[7] := HexDigits[(L SHR 4) AND $F];
  68.     Temp[8] := HexDigits[L AND $F];
  69.     HexLongInt := Temp;
  70.   END;
  71.  
  72.   FUNCTION HexPointer(VAR P) : HexString;
  73.   VAR
  74.     Temp : HexString;
  75.     L    : LongInt ABSOLUTE P;
  76.   BEGIN
  77.     Temp := HexLongInt(L);
  78.     Move(Temp[5], Temp[6], 4);
  79.     Temp[5] := ':';
  80.     Inc(Temp[0]);
  81.     HexPointer := Temp;
  82.   END;
  83.  
  84.   FUNCTION BinByte(B : Byte) : BinString;
  85.   VAR Temp : BinString;
  86.   BEGIN
  87.     Temp[0] := #8;
  88.     Move(BinNibbles[B SHR 4], Temp[1], 4);
  89.     Move(BinNibbles[B AND $F], Temp[5], 4);
  90.     BinByte := Temp;
  91.   END;
  92.  
  93.   FUNCTION BinShortInt(S : ShortInt) : BinString;
  94.   BEGIN BinShortInt := BinByte(Byte(S)); END;
  95.  
  96.   FUNCTION BinWord(W : Word) : BinString;
  97.   VAR Temp : BinString;
  98.   BEGIN
  99.     Temp[0] := #16;
  100.     Move(BinNibbles[W SHR 12], Temp[1], 4);
  101.     Move(BinNibbles[(W SHR 8) AND $F], Temp[5], 4);
  102.     Move(BinNibbles[(W SHR 4) AND $F], Temp[9], 4);
  103.     Move(BinNibbles[W AND $F], Temp[13], 4);
  104.     BinWord := Temp;
  105.   END;
  106.  
  107.   FUNCTION BinInteger(I : Integer) : BinString;
  108.   BEGIN BinInteger := BinWord(Word(I)); END;
  109.  
  110.   FUNCTION BinLongInt(L : LongInt) : BinString;
  111.   VAR Temp : BinString;
  112.   BEGIN
  113.     Temp[0] := #32;
  114.     Move(BinNibbles[L SHR 28], Temp[1], 4);
  115.     Move(BinNibbles[(L SHR 24) AND $F], Temp[5], 4);
  116.     Move(BinNibbles[(L SHR 20) AND $F], Temp[9], 4);
  117.     Move(BinNibbles[(L SHR 16) AND $F], Temp[13], 4);
  118.     Move(BinNibbles[(L SHR 12) AND $F], Temp[17], 4);
  119.     Move(BinNibbles[(L SHR 8) AND $F], Temp[21], 4);
  120.     Move(BinNibbles[(L SHR 4) AND $F], Temp[25], 4);
  121.     Move(BinNibbles[L AND $F], Temp[29], 4);
  122.     BinLongInt := Temp;
  123.   END;
  124.  
  125.   FUNCTION NumBin(B : BinString) : LongInt;
  126.   VAR Accum, Power : LongInt;
  127.     P : Byte;
  128.   BEGIN
  129.     Power := 1; Accum := 0;
  130.     FOR P := length(B) DOWNTO 1 DO
  131.       BEGIN
  132.         IF B[P] = '1' THEN Inc(Accum, Power);
  133.         Power := PoweR SHL 1;
  134.       END;
  135.     NumBin := Accum;
  136.   END;
  137.  
  138.   FUNCTION ANumBin(B : BinString) : LongInt; Assembler;
  139.   ASM
  140.     LES DI, B
  141.     XOR CH, CH
  142.     MOV CL, ES:[DI]
  143.     ADD DI, CX
  144.     MOV AX, 0
  145.     MOV DX, 0
  146.     MOV BX, 1
  147.     MOV SI, 0
  148.     @LOOP:
  149.       CMP BYTE PTR ES:[DI],'1'
  150.       JNE @NotOne
  151.         ADD AX, BX   {add power to accum}
  152.         ADC DX, SI
  153.       @NotOne:
  154.       SHL SI, 1      {double power}
  155.       SHL BX, 1
  156.       ADC SI, 0
  157.       DEC DI
  158.     LOOP @LOOP
  159.   END;
  160.  
  161. END.
  162.